home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / tpmemo.zip / TPMEMO.PAS < prev   
Pascal/Delphi Source File  |  1993-01-04  |  58KB  |  1,949 lines
  1. {$S-,R-,V-,I-,B-,F+}
  2.  
  3. {$IFNDEF Ver40}
  4.   {$I OPLUS.INC}
  5.   {$I AMINUS.INC}
  6. {$ENDIF}
  7.  
  8. {$I TPDEFINE.INC}
  9.  
  10. {*********************************************************}
  11. {*                   TPMEMO.PAS 1.0                      *}
  12. {*        Copyright (c) TurboPower Software 1988.        *}
  13. {* Portions copyright (c) Sunny Hill Software 1985, 1986 *}
  14. {*     and used under license to TurboPower Software     *}
  15. {*                 All rights reserved.                  *}
  16. {*********************************************************}
  17.  
  18. unit TpMemo;
  19.   {-Memo field editor}
  20.  
  21. interface
  22.  
  23. uses
  24.   TpCrt,
  25.   {$IFDEF UseMouse}
  26.   TpMouse,
  27.   {$ENDIF}
  28.   TpCmd,
  29.   TpString;
  30.  
  31.   {.F-}
  32. const
  33.   EMnone       = 00; {Not a command}
  34.   EMchar       = 01; {A character to enter the string}
  35.   EMctrlChar   = 02; {Accept control character}
  36.   EMenter      = 03; {New line}
  37.   EMquit       = 04; {Quit editing}
  38.   EMrestore    = 05; {Restore line and continue}
  39.   EMhome       = 06; {Cursor to beginning of line}
  40.   EMend        = 07; {Cursor to end of line}
  41.   EMleft       = 08; {Cursor left by one character}
  42.   EMright      = 09; {Cursor right by one character}
  43.   EMup         = 10; {Cursor up one line}
  44.   EMdown       = 11; {Cursor down one line}
  45.   EMscrollUp   = 12; {Scroll display up one line}
  46.   EMscrollDown = 13; {Scroll display down one line}
  47.   EMpageUp     = 14; {Scroll display up one page}
  48.   EMpageDown   = 15; {Scroll display down one page}
  49.   EMscreenTop  = 16; {Cursor to top of screen}
  50.   EMscreenBot  = 17; {Cursor to bottom of screen}
  51.   EMtopOfFile  = 18; {Cursor to top of file}
  52.   EMendOfFile  = 19; {Cursor to bottom of file}
  53.   EMwordLeft   = 20; {Cursor left one word}
  54.   EMwordRight  = 21; {Cursor right one word}
  55.   EMback       = 22; {Backspace one character}
  56.   EMdel        = 23; {Delete current character}
  57.   EMdelEol     = 24; {Delete from cursor to end of line}
  58.   EMdelLine    = 25; {Delete entire line}
  59.   EMdelWord    = 26; {Delete word to right of cursor}
  60.   EMtab        = 27; {Tab}
  61.   EMins        = 28; {Toggle insert mode}
  62.   EMindent     = 29; {Toggle auto-indent mode}
  63.   EMwordWrap   = 30; {Toggle word wrap}
  64.   EMreformatP  = 31; {Reformat paragraph}
  65.   EMreformatG  = 32; {Global reformat}
  66.   EMhelp       = 33; {Invoke help routine}
  67.   EMmouse      = 34; {Mouse select}
  68.   EMuser0      = 35; {user-defined exit commands}
  69.   EMuser1      = 36;
  70.   EMuser2      = 37;
  71.   EMuser3      = 38;
  72.   EMuser4      = 39;
  73.   EMuser5      = 40;
  74.   EMuser6      = 41;
  75.   EMuser7      = 42;
  76.   EMuser8      = 43;
  77.   EMuser9      = 44;
  78.   EMuser10     = 45;
  79.   EMuser11     = 46;
  80.   EMuser12     = 47;
  81.   EMuser13     = 48;
  82.   EMuser14     = 49;
  83.   EMuser15     = 50;
  84.   EMuser16     = 51;
  85.   EMuser17     = 52;
  86.   EMuser18     = 53;
  87.   EMuser19     = 54;
  88. {.F+}
  89.  
  90. const
  91.   MaxLineLength : Byte = 127; {!do not make larger than 127!}
  92.  
  93.   {error message codes}
  94.   tmBufferFull    = 1;       {edit buffer is full}
  95.   tmLineTooLong   = 2;       {line too long, CRLF inserted}
  96.   tmTooManyLines  = 3;       {max line limit would be exceeded}
  97.   tmOverLineLimit = 4;       {max line limit already exceeded}
  98.  
  99.   {if True, reformatting routine treats blank space at start of line as
  100.    signalling the start of a new paragraph}
  101.   IndentStartsParagraph : Boolean = False;
  102.  
  103. const
  104.   AllowTruncation : Boolean = True; {read partial files?}
  105.  
  106. type
  107.   EMtype = EMnone..EMuser19;
  108.   EMbuffer = array[1..65521] of Char;
  109.   EMcontrolBlock =
  110.     record
  111.       UserData : Pointer;    {reserved for user (ID number perhaps)}
  112.       XL, YL, XH, YH : Byte; {coordinates for edit window}
  113.       BufPtr : ^EMbuffer;    {pointer to text buffer}
  114.       BufSize : Word;        {size of buffer}
  115.       MaxLines : Integer;    {maximum number of lines}
  116.       TotalBytes : Word;     {bytes in buffer}
  117.       TotalLines : Integer;  {lines in buffer}
  118.       LineAtTop : Integer;   {line at top of edit window}
  119.       BufPosTop : Word;      {index into buffer for start of line at top}
  120.       CurLine : Integer;     {line number of current line}
  121.       BufPos : Word;         {index into buffer for start of current line}
  122.       CurCol : Byte;         {position of cursor within current line}
  123.       ColDelta : Byte;       {for horizontal scrolling}
  124.       KnownLine : Integer;   {used to speed up scrolling/searching}
  125.       KnownOfs : Word;       {"    "  "     "  "}
  126.       TAttr : Byte;          {attribute for normal text}
  127.       CAttr : Byte;          {attribute for control characters}
  128.       InsertMode : Boolean;  {True if in insert mode}
  129.       IndentMode : Boolean;  {True if in auto-indent mode}
  130.       ReadOnlyMode : Boolean;{True if in read-only mode}
  131.       WordWrap : Boolean;    {True if word wrap is on}
  132.       Modified : Boolean;    {True if edits have been made}
  133.       TabDelta : Byte;       {distance between tab stops}
  134.       Margin : Byte;         {right margin}
  135.       HelpTopic : Word;      {help topic}
  136.      end;
  137.  
  138.   MemoStatusType = (
  139.     mstOK, mstNotFound, mstInvalidName, mstReadError, mstTooLarge,
  140.     mstTruncated, mstCreationError, mstWriteError, mstCloseError);
  141.  
  142. const
  143.   MemoKeyPtr : Pointer = nil; {pointer to routine to return next keystroke}
  144.   MemoHelpPtr : Pointer = nil; {pointer to routine to display help}
  145.   MemoStatusPtr : Pointer = nil; {pointer to routine to display status line}
  146.   MemoErrorPtr : Pointer = nil; {pointer to routine to display error messages}
  147.   HelpForMemo = HelpForXXXX1; {special code for help routine calls}
  148.  
  149. const
  150.   {the commands in this set are disallowed in read-only mode}
  151.   DisallowedInReadOnlyMode : set of EMtype =
  152.     [EMchar..EMenter, EMrestore, EMback..EMreformatG];
  153.  
  154. const
  155.   {used only by MemoStatus}
  156.   StatusRow : Byte = 2;      {default to second line of screen for status line}
  157.   StatusAttr : Byte = $F;    {attribute for status line}
  158. const
  159.   {used only by MemoError}
  160.   ErrorRow : Byte = 1;      {default to top line of screen for error messages}
  161.   ErrorAttr : Byte = $F;    {attribute for error message line}
  162.  
  163.   {$IFDEF UseMouse}
  164. const
  165.   {True if mouse support is enabled}
  166.   MemoMouseEnabled : Boolean = False;
  167.   {$ENDIF}
  168. {.F+}
  169.  
  170. procedure InitControlBlock(var EMCB : EMcontrolBlock;
  171.                            XLow, YLow, XHigh, YHigh : Byte;
  172.                            TextAttr, CtrlAttr : Byte;
  173.                            InsertOn, IndentOn, WordWrapOn : Boolean;
  174.                            TabSize : Byte; HelpIndex : Word;
  175.                            RightMargin : Byte; LineLimit : Integer;
  176.                            BufferSize : Word; var Buffer);
  177.   {-Initialize a memo editor control block}
  178.  
  179. function EditMemo(var EMCB : EMcontrolBlock;
  180.                   ReadOnly : Boolean;
  181.                   var CmdList) : EMtype;
  182.   {-Edit a buffer filled with text}
  183.  
  184. procedure MemoStatus(var EMCB : EMcontrolBlock);
  185.   {-Display status line}
  186.  
  187. procedure MemoError(var EMCB : EMcontrolBlock; ErrorCode : Word);
  188.   {-Display error message and wait for key press}
  189.  
  190. function AddMemoCommand(Cmd : EMtype; NumKeys : Byte; Key1, Key2 : Word) : Boolean;
  191.   {-Add a new command key assignment or change an existing one}
  192.  
  193. {$IFDEF UseMouse}
  194.  
  195. procedure EnableMemoMouse;
  196.   {-Enable mouse support in TPMEMO}
  197.  
  198. procedure DisableMemoMouse;
  199.   {-Disable mouse support in TPMEMO}
  200.  
  201. {$ENDIF}
  202.  
  203. {file handling routines}
  204.  
  205. function ReadMemoFile(var Buffer; BufferSize : Word;
  206.                       FName : string; var FSize : LongInt) : MemoStatusType;
  207.   {-Read a file into Buffer, returning a status code}
  208.  
  209. function SaveMemoFile(var EMCB : EMcontrolBlock; FName : string;
  210.                       MakeBackup : Boolean) : MemoStatusType;
  211.   {-Save the current file in the text buffer associated with EMCB}
  212.  
  213.   {.F-}
  214. const
  215.   {Keystroke to command mapping}
  216.   MemoKeyMax = 250;   {last available slot in MemoKeySet}
  217.  
  218.   {ID string for installation programs}
  219.   MemoKeyID : string[16] = 'tpmemo key array';
  220.  
  221.   {default key assignments}
  222.   MemoKeySet : array[0..MemoKeyMax] of Byte = (
  223.    {length keys         command type      key sequence}
  224.     3,     $00, $00,    EMquit,          {^Break}
  225.     3,     $00, $13,    EMreformatG,     {AltR}
  226.     3,     $00, $3B,    EMhelp,          {F1}
  227.     3,     $00, $47,    EMhome,          {Home}
  228.     3,     $00, $48,    EMup,            {Up}
  229.     3,     $00, $49,    EMpageUp,        {PgUp}
  230.     3,     $00, $4B,    EMleft,          {Left}
  231.     3,     $00, $4D,    EMright,         {Right}
  232.     3,     $00, $4F,    EMend,           {End}
  233.     3,     $00, $50,    EMdown,          {Down}
  234.     3,     $00, $51,    EMpageDown,      {PgDn}
  235.     3,     $00, $52,    EMins,           {Ins}
  236.     3,     $00, $53,    EMdel,           {Del}
  237.     3,     $00, $73,    EMwordLeft,      {^Left}
  238.     3,     $00, $74,    EMwordRight,     {^Right}
  239.     3,     $00, $75,    EMscreenBot,     {^End}
  240.     3,     $00, $76,    EMendOfFile,     {^PgDn}
  241.     3,     $00, $77,    EMscreenTop,     {^Home}
  242.     3,     $00, $84,    EMtopOfFile,     {^PgUp}
  243.     2,     $01,         EMwordLeft,      {^A}
  244.     2,     $02,         EMreformatP,     {^B}
  245.     2,     $03,         EMpageDown,      {^C}
  246.     2,     $04,         EMright,         {^D}
  247.     2,     $05,         EMup,            {^E}
  248.     2,     $06,         EMwordRight,     {^F}
  249.     2,     $07,         EMdel,           {^G}
  250.     2,     $08,         EMback,          {^H, Bksp}
  251.     2,     $09,         EMtab,           {^I, Tab}
  252.     2,     $0D,         EMenter,         {^M, Enter}
  253.     2,     $10,         EMctrlChar,      {^P}
  254.     2,     $12,         EMpageUp,        {^R}
  255.     2,     $13,         EMleft,          {^S}
  256.     2,     $14,         EMdelWord,       {^T}
  257.     2,     $16,         EMins,           {^V}
  258.     2,     $17,         EMscrollUp,      {^W}
  259.     2,     $18,         EMdown,          {^X}
  260.     2,     $19,         EMdelLine,       {^Y}
  261.     2,     $1A,         EMscrollDown,    {^Z}
  262.     2,     $1B,         EMquit,          {Esc}
  263.     2,     $7F,         EMback,          {^Bksp}
  264.     3,     $0F, $09,    EMindent,        {^O^I}
  265.     3,     $0F, $17,    EMwordWrap,      {^O^W}
  266.     3,     $11, $03,    EMendOfFile,     {^Q^C}
  267.     3,     $11, $04,    EMend,           {^Q^D}
  268.     3,     $11, $05,    EMscreenTop,     {^Q^E}
  269.     3,     $11, $0C,    EMrestore,       {^Q^L}
  270.     3,     $11, $12,    EMtopOfFile,     {^Q^R}
  271.     3,     $11, $13,    EMhome,          {^Q^S}
  272.     3,     $11, $18,    EMscreenBot,     {^Q^X}
  273.     3,     $11, $19,    EMdelEol,        {^Q^Y}
  274.   {$IFDEF UseMouse}
  275.     3,     $00, $EF,    EMmouse,         {click left  = mouse select}
  276.     3,     $00, $EE,    EMquit,          {click right = ESC}
  277.     3,     $00, $ED,    EMhelp,          {click both  = help}
  278.   {$ELSE}
  279.                             0, 0,        {180}
  280.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0,        {190}
  281.   {$ENDIF}
  282.     {-----------pad to end of array----------}
  283.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0,        {200}
  284.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0,        {210}
  285.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0,        {220}
  286.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0,        {230}
  287.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0,        {240}
  288.     0, 0, 0, 0, 0, 0, 0, 0, 0, 0);       {250}
  289. {.F+}
  290.  
  291.   {routines intended primarily for internal use, but which might be used to
  292.    implement user-defined commands or for other purposes}
  293.  
  294. function FindLineIndex(var EMCB : EMcontrolBlock; LineNum : Integer) : Word;
  295.   {-Return the index into the edit buffer for the specified line number.
  296.     LineNum must be <= EMCB.TotalLines.}
  297.  
  298. function FindLineLength(var EMCB : EMcontrolBlock; LineNum : Integer) : Word;
  299.   {-Find the length of the specified line}
  300.  
  301. procedure InitBufferState(var EMCB : EMcontrolBlock;
  302.                           BufferSize : Word; var Buffer);
  303.   {-Initialize the edit buffer status fields in a control block}
  304.  
  305. procedure GetLine(var EMCB : EMcontrolBlock; var S : string; LineNum : Integer);
  306.   {-Get the LineNum'th line from the buffer for the specified control block
  307.     and store it in S. If line is longer than 255 characters, only the first
  308.     255 characters will be loaded into S.}
  309.  
  310. procedure DrawLine(var EMCB : EMcontrolBlock; St : String; LineNum : Integer);
  311.   {-Draw the string St, which represents the specified line number}
  312.  
  313. procedure FastWriteCtrl(St : String; Row, Col, Attr, Ctrl : Byte);
  314.   {-Write St at Row,Col in Attr (video attribute) without snow.
  315.     Control characters displayed in Ctrl as upper-case letters}
  316.  
  317.   {==========================================================================}
  318.  
  319. implementation
  320.  
  321. const
  322.   SafetyMargin = 2;
  323.   CtrlZ : Char = ^Z;
  324.   CRLF : array[1..2] of Char = ^M^J;
  325.   SearchFailed = $FFFF;
  326.  
  327.   {$L TPMEMO}
  328.  
  329.   procedure FastWriteCtrl(St : String; Row, Col, Attr, Ctrl : Byte);
  330.     {-Write St at Row,Col in Attr (video attribute) without snow.
  331.       Control characters displayed in Ctrl as upper-case letters}
  332.     external;
  333.  
  334.   function Scan(Limit : Integer; Ch : Char; T : Pointer) : Integer;
  335.     {-Scan limit chars for Ch; Ch not found if Result=Limit}
  336.     external;
  337.  
  338.   procedure HelpRoutine(UnitCode : Byte; IdPtr : Pointer; HelpIndex : Word);
  339.     {-Call routine pointed to by MemoHelpPtr}
  340.   inline(
  341.     $FF/$1E/>MemoHelpPtr);   {call dword ptr [>MemoHelpPtr]}
  342.  
  343.   procedure StatusRoutine(var EMCB : EMcontrolBlock);
  344.     {-Call routine pointed to by MemoStatusPtr}
  345.   inline(
  346.     $FF/$1E/>MemoStatusPtr); {call dword ptr [>MemoStatusPtr]}
  347.  
  348.   procedure ErrorRoutine(var EMCB : EMcontrolBlock; ErrorCode : Word);
  349.     {-Call routine pointed to by MemoErrorPtr}
  350.   inline(
  351.     $FF/$1E/>MemoErrorPtr); {call dword ptr [>MemoErrorPtr]}
  352.  
  353.   function GetKey : Word;
  354.     {-Call routine pointed to by MemoKeyPtr}
  355.   inline(
  356.     $FF/$1E/>MemoKeyPtr);    {call dword ptr [>MemoKeyPtr]}
  357.  
  358.   {$IFDEF UseMouse}
  359.  
  360.   procedure HideMousePrim(var MouseState : Boolean);
  361.     {-Save state of mouse cursor in MouseState and hide it}
  362.   begin
  363.     MouseState := MouseCursorOn;
  364.     HideMouse;
  365.   end;
  366.  
  367.   procedure ShowMousePrim(MouseOn : Boolean);
  368.     {-Hide or unhide the mouse cursor}
  369.   begin
  370.     if MouseOn then
  371.       ShowMouse
  372.     else
  373.       HideMouse;
  374.   end;
  375.  
  376.   {$ENDIF}
  377.  
  378.   procedure InitBufferState(var EMCB : EMcontrolBlock;
  379.                             BufferSize : Word; var Buffer);
  380.     {-Initialize the edit buffer status fields in a control block}
  381.   var
  382.     I, J : Word;
  383.     Buf : EMbuffer absolute Buffer;
  384.   begin
  385.     with EMCB do begin
  386.       {reset edit buffer state variables}
  387.       Modified := False;
  388.       BufSize := BufferSize;
  389.       BufPtr := @Buffer;
  390.       BufPos := 1;
  391.       BufPosTop := 1;
  392.       KnownLine := 1;
  393.       KnownOfs := 1;
  394.       CurLine := 1;
  395.       CurCol := 1;
  396.       ColDelta := 0;
  397.       LineAtTop := 1;
  398.  
  399.       {find end of text buffer}
  400.       I := Search(Buffer, BufferSize, CtrlZ, 1);
  401.  
  402.       if (I = SearchFailed) or (I = 0) then begin
  403.         {buffer is empty}
  404.         TotalBytes := 1;
  405.         TotalLines := 1;
  406.         Buf[1] := CtrlZ;
  407.       end
  408.       else begin
  409.         TotalBytes := I+1;
  410.  
  411.         {count total number of rows}
  412.         TotalLines := 1;
  413.         I := 1;
  414.         repeat
  415.           J := Search(Buf[I], Succ(TotalBytes-I), CRLF, 2);
  416.           if J <> SearchFailed then begin
  417.             Inc(TotalLines);
  418.             Inc(I, J+2);
  419.           end;
  420.         until (J = SearchFailed) or (I >= TotalBytes);
  421.       end;
  422.     end;
  423.   end;
  424.  
  425.   procedure InitControlBlock(var EMCB : EMcontrolBlock;
  426.                              XLow, YLow, XHigh, YHigh : Byte;
  427.                              TextAttr, CtrlAttr : Byte;
  428.                              InsertOn, IndentOn, WordWrapOn : Boolean;
  429.                              TabSize : Byte; HelpIndex : Word;
  430.                              RightMargin : Byte; LineLimit : Integer;
  431.                              BufferSize : Word; var Buffer);
  432.     {-Initialize a memo editor control block}
  433.   begin
  434.     with EMCB do begin
  435.       XL := XLow;
  436.       YL := YLow;
  437.       XH := XHigh;
  438.       YH := YHigh;
  439.       TAttr := TextAttr;
  440.       CAttr := CtrlAttr;
  441.       InsertMode := InsertOn;
  442.       IndentMode := IndentOn;
  443.       ReadOnlyMode := False;
  444.       WordWrap := WordWrapOn;
  445.       TabDelta := TabSize;
  446.       if RightMargin = 0 then
  447.         Margin := Succ(XH-XL)
  448.       else if RightMargin > MaxLineLength then
  449.         Margin := MaxLineLength
  450.       else
  451.         Margin := RightMargin;
  452.       if LineLimit <= 0 then
  453.         MaxLines := MaxInt
  454.       else
  455.         MaxLines := LineLimit;
  456.       HelpTopic := HelpIndex;
  457.  
  458.       {initialize TotalLines, TotalBytes, etc.}
  459.       InitBufferState(EMCB, BufferSize, Buffer);
  460.     end;
  461.   end;
  462.  
  463.   procedure MemoStatus(var EMCB : EMcontrolBlock);
  464.     {-Display status line}
  465.   const
  466.     OnOff : array[Boolean] of string[3] = ('Off', 'On ');
  467.     Save : array[Boolean] of string[4] = ('    ', 'SAVE');
  468.     StatusLine : string[80] =
  469.       {         1         2         3         4         5         6         7         8}
  470.       {12345678901234567890123456789012345678901234567890123456789012345678901234567890}
  471.       ' Line: xxxxx  Column: xxx  100%  Insert: Off  Indent: Off  Word wrap: Off  SAVE ';
  472.   var
  473.     S : string[5];
  474.     {$IFDEF UseMouse}
  475.     SaveMouse : Boolean;
  476.     {$ENDIF}
  477.   begin
  478.     with EMCB do begin
  479.       {insert line number}
  480.       S := Long2Str(CurLine);
  481.       S := Pad(S, 5);
  482.       Move(S[1], StatusLine[8], 5);
  483.  
  484.       {insert column number}
  485.       S := Long2Str(CurCol);
  486.       S := Pad(S, 3);
  487.       Move(S[1], StatusLine[23], 3);
  488.  
  489.       {insert percentage of buffer used}
  490.       S := Real2Str(Trunc((TotalBytes*100.0)/(BufSize-SafetyMargin)), 3, 0);
  491.       Move(S[1], StatusLine[28], 3);
  492.  
  493.       {insert remaining fields}
  494.       Move(OnOff[InsertMode][1], StatusLine[42], 3);
  495.       Move(OnOff[IndentMode][1], StatusLine[55], 3);
  496.       Move(OnOff[WordWrap][1], StatusLine[71], 3);
  497.       Move(Save[Modified][1], StatusLine[76], 4);
  498.  
  499.       {$IFDEF UseMouse}
  500.       HideMousePrim(SaveMouse);
  501.       {$ENDIF}
  502.  
  503.       {display status line}
  504.       FastWrite(StatusLine, StatusRow, 1, StatusAttr);
  505.  
  506.       {$IFDEF UseMouse}
  507.       ShowMousePrim(SaveMouse);
  508.       {$ENDIF}
  509.     end;
  510.   end;
  511.  
  512.   procedure MemoError(var EMCB : EMcontrolBlock; ErrorCode : Word);
  513.     {-Display error message and wait for key press}
  514.   var
  515.     S : string[80];
  516.     I : Word;
  517.     {$IFDEF UseMouse}
  518.     SaveMouse : Boolean;
  519.     {$ENDIF}
  520.   begin
  521.     case ErrorCode of
  522.       tmBufferFull  :
  523.         S := 'Edit buffer is full';
  524.       tmLineTooLong :
  525.         S := 'Line too long, carriage return inserted';
  526.       tmTooManyLines :
  527.         S := 'Limit on number of lines has been reached';
  528.       tmOverLineLimit :
  529.         S := 'Limit on number of lines has been exceeded';
  530.       else
  531.         S := 'Unknown error';
  532.     end;
  533.     S := S+'. Press any key...';
  534.  
  535.     {$IFDEF UseMouse}
  536.     HideMousePrim(SaveMouse);
  537.     {$ENDIF}
  538.  
  539.     {display error message}
  540.     FastWrite(Pad(S, ScreenWidth), ErrorRow, 1, ErrorAttr);
  541.  
  542.     {$IFDEF UseMouse}
  543.     ShowMousePrim(SaveMouse);
  544.     {$ENDIF}
  545.  
  546.     {flush the keyboard buffer}
  547.     while KeyPressed do
  548.       I := GetKey;
  549.  
  550.     {wait for key press}
  551.     I := GetKey;
  552.  
  553.     {clear error message line}
  554.     FastWrite(CharStr(' ', ScreenWidth), ErrorRow, 1, ErrorAttr);
  555.   end;
  556.  
  557.   function FindLineIndex(var EMCB : EMcontrolBlock; LineNum : Integer) : Word;
  558.     {-Return the index into the edit buffer for the specified line number}
  559.   var
  560.     I : Integer;
  561.   begin
  562.     with EMCB do begin
  563.       if LineNum = 1 then begin
  564.         KnownLine := 1;
  565.         KnownOfs := 1;
  566.       end
  567.       else if LineNum >= KnownLine then
  568.         while KnownLine < LineNum do begin
  569.           I := Succ(TotalBytes-KnownOfs);
  570.           if I < 0 then
  571.             I := MaxInt;
  572.           Inc(KnownOfs, Succ(Scan(I, ^J, @BufPtr^[KnownOfs])));
  573.           Inc(KnownLine);
  574.         end
  575.       else begin
  576.         {linenum < knownline, search backwards}
  577.         Dec(KnownOfs, 2);
  578.         while KnownLine > LineNum do begin
  579.           I := KnownOfs;
  580.           if I < 0 then
  581.             I := MaxInt;
  582.           Inc(Integer(KnownOfs), Pred(Scan(-I, ^J, @BufPtr^[KnownOfs])));
  583.           Dec(KnownLine);
  584.         end;
  585.  
  586.         {point to start of next line}
  587.         Inc(KnownOfs, 2);
  588.       end;
  589.  
  590.       FindLineIndex := KnownOfs;
  591.     end;
  592.   end;
  593.  
  594.   function FindLineLength(var EMCB : EMcontrolBlock; LineNum : Integer) : Word;
  595.     {-Find the length of the specified line}
  596.   var
  597.     I, J : Word;
  598.   begin
  599.     with EMCB do
  600.       if LineNum > TotalLines then
  601.         FindLineLength := 0
  602.       else begin
  603.         {find starting index for line}
  604.         J := FindLineIndex(EMCB, LineNum);
  605.  
  606.         {calculate length}
  607.         I := Search(BufPtr^[J], Succ(TotalBytes-J), CRLF, 2);
  608.         if I = SearchFailed then
  609.           FindLineLength := TotalBytes-J
  610.         else
  611.           FindLineLength := I;
  612.       end;
  613.   end;
  614.  
  615.   procedure GetLine(var EMCB : EMcontrolBlock; var S : string; LineNum : Integer);
  616.     {-Get the LineNum'th line from the buffer for the specified control block,
  617.       and store it in S}
  618.   var
  619.     I, J : Word;
  620.     SLen : Byte absolute S;
  621.   begin
  622.     with EMCB do
  623.       if LineNum > TotalLines then
  624.         SLen := 0
  625.       else begin
  626.         {find starting index and length for line}
  627.         J := FindLineIndex(EMCB, LineNum);
  628.         I := FindLineLength(EMCB, LineNum);
  629.  
  630.         {truncate if line is too long}
  631.         if I > 255 then
  632.           SLen := 255
  633.         else
  634.           SLen := I;
  635.  
  636.         Move(BufPtr^[J], S[1], SLen);
  637.       end;
  638.   end;
  639.  
  640.   procedure DrawLine(var EMCB : EMcontrolBlock; St : String; LineNum : Integer);
  641.     {-Draw the string St, which represents the specified line number}
  642.   var
  643.     StLen : Byte absolute St;
  644.     WinWidth : Byte;
  645.   begin
  646.     {calculate screen row}
  647.     Dec(LineNum, Pred(EMCB.LineAtTop));
  648.     Inc(LineNum, Pred(EMCB.YL));
  649.  
  650.     with EMCB do begin
  651.       WinWidth := Succ(XH-XL);
  652.  
  653.       {adjust for ColDelta}
  654.       if (ColDelta > 0) and (StLen > 0) then
  655.         if ColDelta >= StLen then
  656.           StLen := 0
  657.         else begin
  658.           Move(St[ColDelta+1], St[1], StLen-ColDelta);
  659.           Dec(StLen, ColDelta);
  660.         end;
  661.     end;
  662.  
  663.     {pad the end of the string}
  664.     if StLen < WinWidth then
  665.       FillChar(St[Succ(StLen)], WinWidth-StLen, ' ');
  666.  
  667.     {change the length}
  668.     StLen := WinWidth;
  669.  
  670.     {draw the string}
  671.     with EMCB do
  672.       if CAttr = TAttr then
  673.         FastWrite(St, LineNum, XL, TAttr)
  674.       else
  675.         FastWriteCtrl(St, LineNum, XL, TAttr, CAttr);
  676.   end;
  677.  
  678.   function EditMemo(var EMCB : EMcontrolBlock;
  679.                     ReadOnly : Boolean;
  680.                     var CmdList) : EMtype;
  681.     {-Edit a buffer filled with text}
  682.   type
  683.     CmdListType = array[1..100] of EMtype;
  684.   var
  685.     ChWord : Word;
  686.     Ch : Char absolute ChWord;
  687.     OldSt, St : string;      {text of current line}
  688.     OldCol : Byte;
  689.     OldModified : Boolean;
  690.     StLen : Byte absolute St;
  691.     I, J : Word;
  692.     CursorSL : Word;
  693.     CursorXY : Word;
  694.     SaveBreak : Boolean;
  695.     ForceRedraw : Boolean;
  696.     DoingChars : Boolean;
  697.     Done, OK : Boolean;
  698.     WinWidth : Byte;
  699.     EMC : EMtype;
  700.     UserCmdList : CmdListType absolute CmdList;
  701.     NextUserCmd : Word;
  702.     {$IFDEF UseMouse}
  703.     SaveWaitState : Boolean;
  704.     SaveMouse : Boolean;
  705.     {$ENDIF}
  706.  
  707.     procedure CallErrorRoutine(Code : Integer);
  708.       {-Call the user-defined error routine}
  709.     begin
  710.       if MemoErrorPtr <> nil then
  711.         ErrorRoutine(EMCB, Code);
  712.     end;
  713.  
  714.     procedure TrimSpaces;
  715.       {-Trim trailing blanks from current line}
  716.     begin
  717.       while St[StLen] = ' ' do
  718.         Dec(StLen);
  719.     end;
  720.  
  721.     function InsertOK(N : Integer) : Boolean;
  722.       {-Return True if OK to insert N bytes into the edit buffer. Calls user
  723.         error handler if not OK.}
  724.     var
  725.       I : LongInt;
  726.     begin
  727.       with EMCB do begin
  728.         {allow a safety margin}
  729.         I := TotalBytes+SafetyMargin;
  730.  
  731.         {calculate actual TotalBytes+N}
  732.         Inc(I, LongInt(N)+(LongInt(StLen)-Length(OldSt)));
  733.  
  734.         if I <= BufSize then
  735.           InsertOK := True
  736.         else begin
  737.           InsertOK := False;
  738.           CallErrorRoutine(tmBufferFull);
  739.         end;
  740.       end;
  741.     end;
  742.  
  743.     procedure ToggleInsertMode;
  744.       {-Toggle between insert and overtype mode, keeping BIOS keyboard flag up
  745.         to date}
  746.     var
  747.       BiosKbdFlag : Byte absolute $0040 : $0017;
  748.     begin
  749.       with EMCB do begin
  750.         {toggle insert flag}
  751.         InsertMode := not InsertMode;
  752.  
  753.         {use fat cursor if inserting}
  754.         if InsertMode then begin
  755.           FatCursor;
  756.           BiosKbdFlag := BiosKbdFlag or $80;
  757.         end
  758.         else begin
  759.           NormalCursor;
  760.           BiosKbdFlag := BiosKbdFlag and $7F;
  761.         end;
  762.       end;
  763.     end;
  764.  
  765.     procedure DrawCurrentLine;
  766.       {-Draw the current line}
  767.       {$IFDEF UseMouse}
  768.       var
  769.         SaveMouse : Boolean;
  770.       {$ENDIF}
  771.     begin
  772.       {$IFDEF UseMouse}
  773.       HideMousePrim(SaveMouse);
  774.       {$ENDIF}
  775.  
  776.       {draw the current line}
  777.       DrawLine(EMCB, St, EMCB.CurLine);
  778.  
  779.       {$IFDEF UseMouse}
  780.       ShowMousePrim(SaveMouse);
  781.       {$ENDIF}
  782.     end;
  783.  
  784.     procedure RedrawScreen;
  785.       {-Redraw entire screen}
  786.     var
  787.       I, J : Integer;
  788.       S : String;
  789.       {$IFDEF UseMouse}
  790.       SaveMouse : Boolean;
  791.       {$ENDIF}
  792.     begin
  793.       {$IFDEF UseMouse}
  794.       HideMousePrim(SaveMouse);
  795.       {$ENDIF}
  796.  
  797.       with EMCB do begin
  798.         J := LineAtTop+(YH-YL);
  799.         for I := LineAtTop to J do begin
  800.           if (I = CurLine) then
  801.             DrawLine(EMCB, St, I)
  802.           else begin
  803.             GetLine(EMCB, S, I);
  804.             DrawLine(EMCB, S, I);
  805.           end;
  806.         end;
  807.       end;
  808.  
  809.       {$IFDEF UseMouse}
  810.       ShowMousePrim(SaveMouse);
  811.       {$ENDIF}
  812.  
  813.       ForceRedraw := False;
  814.     end;
  815.  
  816.     procedure SaveCurrentLine(Trim : Boolean);
  817.       {-Patch the current line back into place}
  818.     var
  819.       I, J : Word;
  820.       K : Integer;
  821.     begin
  822.       with EMCB do begin
  823.         if Trim then
  824.           TrimSpaces;
  825.         if St = OldSt then
  826.           Exit;
  827.  
  828.         {find the actual length of the current line}
  829.         I := BufPos;
  830.         J := FindLineLength(EMCB, CurLine);
  831.  
  832.         {calculate difference in size}
  833.         K := Integer(StLen)-J;
  834.  
  835.         if K > 0 then
  836.           {make room for new text}
  837.           Move(BufPtr^[I], BufPtr^[I+K], Succ(TotalBytes-I))
  838.         else
  839.           {delete excess characters}
  840.           Move(BufPtr^[I-K], BufPtr^[I], Succ(TotalBytes-I)+K);
  841.  
  842.         {insert the text}
  843.         Move(St[1], BufPtr^[I], StLen);
  844.         Inc(TotalBytes, K);
  845.  
  846.         KnownLine := LineAtTop;
  847.         KnownOfs := BufPosTop;
  848.         OldSt := St;
  849.         Modified := True;
  850.         OldModified := True;
  851.       end;
  852.     end;
  853.  
  854.     procedure ScrollDisplay(Lines : Integer);
  855.       {-Scroll the editing window up or down}
  856.     var
  857.       S : string;
  858.       SaveTextAttr : Byte;
  859.       I, J, K : Integer;
  860.       {$IFDEF UseMouse}
  861.       SaveMouse : Boolean;
  862.       {$ENDIF}
  863.     begin
  864.       if Lines = 0 then
  865.         Exit;
  866.       with EMCB do begin
  867.         SaveTextAttr := TextAttr;
  868.         TextAttr := TAttr;
  869.  
  870.         {$IFDEF UseMouse}
  871.         HideMousePrim(SaveMouse);
  872.         {$ENDIF}
  873.  
  874.         if Lines < 0 then
  875.           ScrollWindowDown(XL, YL, XH, YH, -Lines)
  876.         else
  877.           ScrollWindowUp(XL, YL, XH, YH, Lines);
  878.  
  879.         BufPosTop := FindLineIndex(EMCB, LineAtTop+Lines);
  880.         Inc(LineAtTop, Lines);
  881.  
  882.         if Lines < 0 then begin
  883.           J := LineAtTop;
  884.           K := Pred(J-Lines);
  885.         end
  886.         else begin
  887.           J := LineAtTop+(YH-YL)-Pred(Lines);
  888.           K := Pred(J+Lines);
  889.         end;
  890.  
  891.         {draw the line(s) replacing the one(s) that scrolled off}
  892.         for I := J to K do begin
  893.           GetLine(EMCB, S, I);
  894.           DrawLine(EMCB, S, I);
  895.         end;
  896.  
  897.         {$IFDEF UseMouse}
  898.         ShowMousePrim(SaveMouse);
  899.         {$ENDIF}
  900.  
  901.         TextAttr := SaveTextAttr;
  902.       end;
  903.     end;
  904.  
  905.     function TooManyLinesCheck : Boolean;
  906.       {-Check to see if there are too many lines}
  907.     begin
  908.       with EMCB do
  909.         if Word(TotalLines) >= Word(MaxLines) then begin
  910.           CallErrorRoutine(tmTooManyLines);
  911.           OK := False;
  912.           TooManyLinesCheck := True;
  913.         end
  914.         else
  915.           TooManyLinesCheck := False;
  916.     end;
  917.  
  918.     procedure InsLinePrim(LineNum, Col : Integer);
  919.       {-Primitive routine to insert a line break}
  920.     var
  921.       I, J : Word;
  922.     begin
  923.       with EMCB do begin
  924.         if TooManyLinesCheck then
  925.           Exit;
  926.  
  927.         {find the place to insert the line break}
  928.         I := FindLineIndex(EMCB, LineNum)+Pred(Col);
  929.  
  930.         {see if we need to trim some blanks}
  931.         J := Pred(I);
  932.         while (J > 0) and (BufPtr^[J] = ' ') do
  933.           Dec(J);
  934.         Inc(J);
  935.  
  936.         if J <> I then begin
  937.           {see if there's room}
  938.           OK := InsertOK(2-(I-J));
  939.           if not OK then
  940.             Exit;
  941.  
  942.           {make room for a CRLF}
  943.           Move(BufPtr^[I], BufPtr^[J+2], Succ(TotalBytes-I));
  944.  
  945.           {insert the CRLF}
  946.           Move(CRLF, BufPtr^[J], 2);
  947.  
  948.           {adjust counters}
  949.           Inc(TotalLines);
  950.           TotalBytes := (TotalBytes+2)-(I-J);
  951.         end
  952.         else begin
  953.           {see if there's room}
  954.           OK := InsertOK(2);
  955.           if not OK then
  956.             Exit;
  957.  
  958.           {make room for a CRLF}
  959.           Move(BufPtr^[I], BufPtr^[I+2], Succ(TotalBytes-I));
  960.  
  961.           {insert the CRLF}
  962.           Move(CRLF, BufPtr^[I], 2);
  963.  
  964.           {adjust counters}
  965.           Inc(TotalLines);
  966.           Inc(TotalBytes, 2);
  967.         end;
  968.  
  969.         Modified := True;
  970.       end;
  971.     end;
  972.  
  973.     procedure LoadLine(LineNum : Integer; Truncate : Boolean);
  974.       {-Load the specified line}
  975.     var
  976.       I, J, K, N, Max : Word;
  977.     begin
  978.       with EMCB do begin
  979.         {find the line we're moving to}
  980.         BufPos := FindLineIndex(EMCB, LineNum);
  981.         CurLine := LineNum;
  982.  
  983.         {find the length of the line}
  984.         I := FindLineLength(EMCB, LineNum);
  985.  
  986.         {calc max length of line}
  987.         if Truncate then
  988.           Max := MaxLineLength
  989.         else
  990.           Max := 255;
  991.  
  992.         {insert carriage return if line is too long}
  993.         if I > Max then begin
  994.           {determine where to break the line}
  995.           K := Max;
  996.           N := FindLineIndex(EMCB, LineNum);
  997.           J := N+Pred(K);
  998.           while (J > N) and (BufPtr^[J] <> ' ') do begin
  999.             Dec(J);
  1000.             Dec(K);
  1001.           end;
  1002.           if J = N then
  1003.             K := Max;
  1004.  
  1005.           {try to break the line}
  1006.           Inc(MaxLines);
  1007.           InsLinePrim(LineNum, K);
  1008.           Dec(MaxLines);
  1009.  
  1010.           if not OK then begin
  1011.             {something overflowed--force the line break}
  1012.             Inc(N, K);
  1013.             BufPtr^[N] := ^M;
  1014.             BufPtr^[N+1] := ^J;
  1015.             Inc(TotalLines);
  1016.           end;
  1017.  
  1018.           {report the break}
  1019.           CallErrorRoutine(tmLineTooLong);
  1020.  
  1021.           {force screen to be redrawn}
  1022.           ForceRedraw := True;
  1023.  
  1024.           {recalculate the length}
  1025.           I := FindLineLength(EMCB, LineNum);
  1026.         end;
  1027.  
  1028.         {load the line into St and OldSt}
  1029.         StLen := I;
  1030.         Move(BufPtr^[BufPos], St[1], StLen);
  1031.         OldSt := St;
  1032.         OldCol := CurCol;
  1033.         Modified := OldModified;
  1034.       end;
  1035.     end;
  1036.  
  1037.     procedure GotoLine(LineNum : Integer; Trim : Boolean);
  1038.       {-Save the current line and move the cursor to the LineNum'th line}
  1039.     var
  1040.       I : Word;
  1041.     begin
  1042.       with EMCB do begin
  1043.         {don't go too far}
  1044.         if LineNum > TotalLines then
  1045.           LineNum := TotalLines;
  1046.  
  1047.         {save the line we've been editing}
  1048.         SaveCurrentLine(Trim);
  1049.  
  1050.         {scroll the display if necessary}
  1051.         if LineNum < LineAtTop then
  1052.           ScrollDisplay(LineNum-LineAtTop)
  1053.         else begin
  1054.           I := LineAtTop+(YH-YL);
  1055.           if LineNum > I then
  1056.             ScrollDisplay(LineNum-I);
  1057.         end;
  1058.  
  1059.         {load the line}
  1060.         LoadLine(LineNum, Trim);
  1061.       end;
  1062.     end;
  1063.  
  1064.     procedure DelLinePrim(LineNum : Integer);
  1065.       {-Primitive routine to delete a line}
  1066.     var
  1067.       I, J : Word;
  1068.     begin
  1069.       with EMCB do begin
  1070.         {find the line we're deleting}
  1071.         I := FindLineIndex(EMCB, LineNum);
  1072.  
  1073.         {find the length of the line}
  1074.         J := Search(BufPtr^[I], Succ(TotalBytes-I), CRLF, 2);
  1075.         if J = SearchFailed then
  1076.           J := TotalBytes-BufPos
  1077.         else
  1078.           Inc(J, 2);
  1079.  
  1080.         {delete it}
  1081.         Move(BufPtr^[I+J], BufPtr^[I], Succ(TotalBytes-I)-J);
  1082.         Dec(TotalLines);
  1083.         if TotalLines = 0 then begin
  1084.           TotalLines := 1;
  1085.           TotalBytes := 1;
  1086.           BufPtr^[1] := ^Z;
  1087.         end
  1088.         else
  1089.           Dec(TotalBytes, J);
  1090.  
  1091.         Modified := True;
  1092.         OldModified := True;
  1093.       end;
  1094.     end;
  1095.  
  1096.     procedure JoinLinePrim(LineNum : Integer);
  1097.       {-Primitive routine to join two lines}
  1098.     var
  1099.       I : Word;
  1100.     begin
  1101.       with EMCB do begin
  1102.         {find the place to join the lines}
  1103.         I := FindLineIndex(EMCB, LineNum);
  1104.  
  1105.         {make room for a CRLF}
  1106.         Move(BufPtr^[I], BufPtr^[I-2], Succ(TotalBytes-I));
  1107.  
  1108.         Dec(TotalLines);
  1109.         Dec(TotalBytes, 2);
  1110.         BufPtr^[TotalBytes+1] := ^Z;
  1111.  
  1112.         Modified := True;
  1113.         OldModified := True;
  1114.       end;
  1115.     end;
  1116.  
  1117.     procedure PutLineAtTop(LineNum : Integer);
  1118.       {-Position the specified line at top of editing window}
  1119.     begin
  1120.       with EMCB do begin
  1121.         if LineNum < 1 then
  1122.           LineNum := 1
  1123.         else if LineNum > TotalLines then
  1124.           LineNum := TotalLines;
  1125.         BufPosTop := FindLineIndex(EMCB, LineNum);
  1126.         LineAtTop := LineNum;
  1127.         RedrawScreen;
  1128.       end;
  1129.     end;
  1130.  
  1131.     function GetIndent(S : string) : Byte;
  1132.       {-Get the indentation level of S}
  1133.     var
  1134.       I : Word;
  1135.       SLen : Byte absolute S;
  1136.     begin
  1137.       I := 0;
  1138.       while S[SLen] = ' ' do
  1139.         Dec(SLen);
  1140.       while (I < SLen) and (S[I+1] = ' ') do
  1141.         Inc(I);
  1142.       GetIndent := I;
  1143.     end;
  1144.  
  1145.     procedure WrapLine(Trim : Boolean);
  1146.       {-Word wrap the current line}
  1147.     var
  1148.       I, J : Integer;
  1149.       Temp, SaveSt : string;
  1150.     begin
  1151.       with EMCB do begin
  1152.         if TooManyLinesCheck then
  1153.           Exit;
  1154.         SaveSt := St;
  1155.         TpString.WordWrap(St, St, Temp, Margin, False);
  1156.         if IndentMode then begin
  1157.           I := GetIndent(St);
  1158.           if I <> 0 then
  1159.             Insert(CharStr(' ', I), Temp, 1);
  1160.         end;
  1161.         I := Length(Temp)-(Length(SaveSt)-CurCol);
  1162.         if I < 1 then
  1163.           I := 1;
  1164.         SaveCurrentLine(True);
  1165.         DrawCurrentLine;
  1166.         InsLinePrim(CurLine, StLen+1);
  1167.         if OK then begin
  1168.           GotoLine(CurLine+1, Trim);
  1169.           St := Temp;
  1170.           SaveCurrentLine(True);
  1171.           ColDelta := 0;
  1172.           CurCol := I;
  1173.           OldCol := I;
  1174.         end
  1175.         else begin
  1176.           St := SaveSt;
  1177.           SaveCurrentLine(True);
  1178.         end;
  1179.       end;
  1180.     end;
  1181.  
  1182.     procedure ReformatParagraph;
  1183.       {-Reformat a paragraph starting at the current line}
  1184.     var
  1185.       SaveMax, I : Integer;
  1186.       Temp : string;
  1187.     begin
  1188.       with EMCB do begin
  1189.         SaveCurrentLine(True);
  1190.  
  1191.         if StLen = 0 then begin
  1192.           GotoLine(CurLine+1, True);
  1193.           Exit;
  1194.         end;
  1195.  
  1196.         {ignore line limit when reformatting}
  1197.         SaveMax := MaxLines;
  1198.         MaxLines := MaxInt;
  1199.  
  1200.         while (CurLine < TotalLines) and (OK = True) do begin
  1201.           while (StLen > Margin) and OK do
  1202.             WrapLine(False);
  1203.           if OK then
  1204.             OK := FindLineLength(EMCB, CurLine+1) <> 0;
  1205.           if OK and IndentStartsParagraph then
  1206.             OK := BufPtr^[KnownOfs] <> ' ';
  1207.  
  1208.           if OK then begin
  1209.             Inc(StLen);
  1210.             St[StLen] := ' ';
  1211.             I := Succ(StLen);
  1212.             SaveCurrentLine(False);
  1213.             JoinLinePrim(CurLine+1);
  1214.             LoadLine(CurLine, False);
  1215.             while (I < StLen) and (St[I] = ' ') do
  1216.               Delete(St, I, 1);
  1217.             TrimSpaces;
  1218.           end;
  1219.         end;
  1220.  
  1221.         OK := True;
  1222.         while (StLen > Margin) and OK do
  1223.           WrapLine(False);
  1224.  
  1225.         RedrawScreen;
  1226.         GotoLine(CurLine+1, True);
  1227.         if CurLine = TotalLines then
  1228.           CurCol := Succ(StLen)
  1229.         else
  1230.           CurCol := 1;
  1231.         OldCol := CurCol;
  1232.         MaxLines := SaveMax;
  1233.       end;
  1234.     end;
  1235.  
  1236.     procedure DeleteWordPrim;
  1237.       {-Primitive routine to delete a word}
  1238.     var
  1239.       DelEnd : Word;
  1240.     begin
  1241.       with EMCB do begin
  1242.         if CurCol > StLen then
  1243.           Exit;
  1244.  
  1245.         {start deleting at the cursor}
  1246.         DelEnd := CurCol;
  1247.  
  1248.         {delete all of the current word, if any}
  1249.         if St[CurCol] <> ' ' then
  1250.           while (St[DelEnd] <> ' ') and (DelEnd <= StLen) do
  1251.             Inc(DelEnd);
  1252.  
  1253.         {delete any spaces prior to the next word, if any}
  1254.         while (St[DelEnd] = ' ') and (DelEnd <= StLen) do
  1255.           Inc(DelEnd);
  1256.  
  1257.         Delete(St, CurCol, DelEnd-CurCol);
  1258.       end;
  1259.     end;
  1260.  
  1261.     {$IFDEF UseMouse}
  1262.  
  1263.     procedure MouseSelect;
  1264.       {-Move cursor to position of mouse}
  1265.     var
  1266.       CurRow, TargetLine : Integer;
  1267.       TargetRow, TargetCol : Integer;
  1268.     begin
  1269.       {convert mouse X and Y coordinates to absolute row and col}
  1270.       TargetRow := MouseKeyWordY+MouseYLo;
  1271.       TargetCol := MouseKeyWordX+MouseXLo;
  1272.  
  1273.       with EMCB do
  1274.         {make sure mouse is within edit window}
  1275.         if (TargetCol >= XL) and (TargetCol <= XH)
  1276.         and (TargetRow >= YL) and (TargetRow <= YH) then begin
  1277.           {calculate current screen row}
  1278.           CurRow := Word(YL)+(CurLine-LineAtTop);
  1279.  
  1280.           {calculate target line number}
  1281.           TargetLine := CurLine+(TargetRow-CurRow);
  1282.  
  1283.           if TargetLine <= TotalLines then begin
  1284.             {move cursor to desired location}
  1285.             CurCol := TargetCol-Pred(XL)-ColDelta;
  1286.             GotoLine(TargetLine, True);
  1287.           end;
  1288.         end;
  1289.     end;
  1290.  
  1291.     {$ENDIF}
  1292.  
  1293.     procedure TopOfFile;
  1294.       {-Reset for top of file}
  1295.     begin
  1296.       with EMCB do begin
  1297.         PutLineAtTop(1);
  1298.         GotoLine(1, True);
  1299.         CurCol := 1;
  1300.         OldCol := 1;
  1301.         RedrawScreen;
  1302.       end;
  1303.     end;
  1304.  
  1305.     procedure ReformatGlobally;
  1306.       {-Reformat entire file}
  1307.     begin
  1308.       with EMCB do begin
  1309.         {skip all this if the file is empty}
  1310.         if TotalBytes = 1 then
  1311.           Exit;
  1312.  
  1313.         {go to top of file}
  1314.         TopOfFile;
  1315.  
  1316.         {while not at last line, reformat paragraphs}
  1317.         while CurLine < TotalLines do
  1318.           ReformatParagraph;
  1319.       end;
  1320.     end;
  1321.  
  1322.     procedure CheckLineLimit;
  1323.       {-Display error message if line limit exceeded}
  1324.     begin
  1325.       with EMCB do
  1326.         if TotalLines > MaxLines then begin
  1327.           RedrawScreen;
  1328.           CallErrorRoutine(tmOverLineLimit);
  1329.         end;
  1330.     end;
  1331.  
  1332.   begin
  1333.     with EMCB do begin
  1334.       {Store cursor position and shape}
  1335.       GetCursorState(CursorXY, CursorSL);
  1336.  
  1337.       {Save break checking state}
  1338.       SaveBreak := CheckBreak;
  1339.       CheckBreak := False;
  1340.  
  1341.       {set cursor shape}
  1342.       InsertMode := not InsertMode;
  1343.       ToggleInsertMode;
  1344.  
  1345.       {initialize miscellaneous variables}
  1346.       WinWidth := Succ(XH-XL);
  1347.       NextUserCmd := 1;
  1348.       KnownLine := 1;
  1349.       KnownOfs := 1;
  1350.       OldModified := Modified;
  1351.       ReadOnlyMode := ReadOnly;
  1352.  
  1353.       {$IFDEF UseMouse}
  1354.       SaveMouse := MouseCursorOn;
  1355.       {$ENDIF}
  1356.  
  1357.       {get the first line}
  1358.       LoadLine(EMCB.CurLine, True);
  1359.  
  1360.       {draw whole screen}
  1361.       ForceRedraw := True;
  1362.  
  1363.       {see if we exceeded the line limit}
  1364.       CheckLineLimit;
  1365.  
  1366.       {loop while reading keys}
  1367.       Done := False;
  1368.       DoingChars := False;
  1369.       repeat
  1370.         OK := True;
  1371.  
  1372.         {update screen}
  1373.         if CurCol > MaxLineLength+1 then
  1374.           CurCol := MaxLineLength+1;
  1375.         if CurCol > WinWidth+ColDelta then begin
  1376.           ColDelta := CurCol-WinWidth;
  1377.           RedrawScreen;
  1378.         end
  1379.         else if CurCol < Succ(ColDelta) then begin
  1380.           ColDelta := Pred(CurCol);
  1381.           RedrawScreen;
  1382.         end
  1383.         else if ForceRedraw then
  1384.           RedrawScreen
  1385.         else
  1386.           DrawCurrentLine;
  1387.  
  1388.         {position cursor}
  1389.         GoToXYAbs(XL+Pred(CurCol)-ColDelta, YL+(CurLine-LineAtTop));
  1390.  
  1391.         {set modified flag}
  1392.         TrimSpaces;
  1393.         Modified := OldModified or (St <> OldSt);
  1394.  
  1395.         {display status line}
  1396.         if MemoStatusPtr <> nil then begin
  1397.           {update TotalBytes field for status routine}
  1398.           J := TotalBytes;
  1399.           Inc(TotalBytes, Integer(StLen)-Length(OldSt));
  1400.  
  1401.           {call status routine}
  1402.           StatusRoutine(EMCB);
  1403.  
  1404.           {reset TotalBytes field}
  1405.           TotalBytes := J;
  1406.         end;
  1407.  
  1408.         {$IFDEF UseMouse}
  1409.         if MemoMouseEnabled then begin
  1410.           SaveWaitState := WaitForButtonRelease;
  1411.           WaitForButtonRelease := True;
  1412.         end;
  1413.         {$ENDIF}
  1414.  
  1415.         {see if there is a user command left to process}
  1416.         EMC := UserCmdList[NextUserCmd];
  1417.         if DoingChars then begin
  1418.           if EMC = EMchar then begin
  1419.             {EMchar acts as toggle}
  1420.             EMC := EMnone;
  1421.             DoingChars := False;
  1422.           end
  1423.           else begin
  1424.             {treat the command as a character}
  1425.             Ch := Char(EMC);
  1426.             EMC := EMchar;
  1427.           end;
  1428.           Inc(NextUserCmd);
  1429.         end
  1430.         else if EMC = EMnone then
  1431.           {read from the keyboard}
  1432.           EMC := GetCommand(MemoKeySet, MemoKeyPtr, ChWord)
  1433.         else begin
  1434.           {process next user command}
  1435.           Inc(NextUserCmd);
  1436.           if EMC = EMchar then begin
  1437.             DoingChars := True;
  1438.             EMC := EMnone;
  1439.           end;
  1440.         end;
  1441.  
  1442.         {make sure command is allowable if in read-only mode}
  1443.         if ReadOnlyMode then
  1444.           if EMC in DisallowedInReadOnlyMode then
  1445.             EMC := EMnone;
  1446.  
  1447.         {reinterpret potentially troublesome control characters}
  1448.         if EMC = EMchar then
  1449.           case Ch of
  1450.             ^M : EMC := EMenter;
  1451.             ^J, ^Z : EMC := EMnone;
  1452.           end;
  1453.  
  1454.         {$IFDEF UseMouse}
  1455.         if MemoMouseEnabled then
  1456.           WaitForButtonRelease := SaveWaitState;
  1457.         {$ENDIF}
  1458.  
  1459.         {deal with control characters if desired}
  1460.         if EMC = EMctrlChar then
  1461.           {don't allow control characters if attributes are the same}
  1462.           if (CAttr = TAttr) then
  1463.             EMC := EMnone
  1464.           else begin
  1465.             BlockCursor;
  1466.             ChWord := GetKey;
  1467.             EMC := EMchar;
  1468.             if InsertMode then
  1469.               FatCursor
  1470.             else
  1471.               NormalCursor;
  1472.           end;
  1473.  
  1474.         case EMC of
  1475.           EMchar :             {A character to enter the string}
  1476.             if CurCol <= MaxLineLength then begin
  1477.               if CurCol > StLen then
  1478.                 FillChar(St[Succ(StLen)], CurCol-StLen, ' ');
  1479.  
  1480.               if not InsertMode then begin
  1481.                 {overtype mode}
  1482.                 if (CurCol <= MaxLineLength) then begin
  1483.                   St[CurCol] := Ch;
  1484.                   if (Ch <> ' ') and (CurCol > StLen) and InsertOK(CurCol-StLen) then
  1485.                     StLen := CurCol;
  1486.                   Inc(CurCol);
  1487.                 end;
  1488.               end
  1489.               else if StLen < MaxLineLength then begin
  1490.                 {insert mode}
  1491.                 if CurCol > StLen then begin
  1492.                   if Ch = ' ' then
  1493.                     Inc(CurCol)
  1494.                   else if InsertOK(CurCol-StLen) then begin
  1495.                     StLen := CurCol;
  1496.                     St[CurCol] := Ch;
  1497.                     Inc(CurCol);
  1498.                   end;
  1499.                 end
  1500.                 else if InsertOK(1) then begin
  1501.                   Insert(Ch, St, CurCol);
  1502.                   Inc(CurCol);
  1503.                 end;
  1504.               end;
  1505.  
  1506.               if WordWrap and (CurCol > Margin) and (StLen > Margin) then begin
  1507.                 WrapLine(True);
  1508.                 ForceRedraw := True;
  1509.               end;
  1510.             end;
  1511.  
  1512.           EMenter :            {new line}
  1513.             begin
  1514.               I := GetIndent(St);
  1515.               if InsertMode then begin
  1516.                 if IndentMode and (CurCol <= StLen) and (I > 0) then
  1517.                   Insert(CharStr(' ', I), St, CurCol);
  1518.                 SaveCurrentLine(True);
  1519.                 if CurCol > StLen then
  1520.                   CurCol := Succ(StLen);
  1521.                 InsLinePrim(CurLine, CurCol);
  1522.               end;
  1523.  
  1524.               if OK then begin
  1525.                 GotoLine(CurLine+1, True);
  1526.                 if IndentMode and InsertMode then
  1527.                   CurCol := Succ(I)
  1528.                 else
  1529.                   CurCol := 1;
  1530.                 OldCol := CurCol;
  1531.                 if InsertMode then
  1532.                   ForceRedraw := True;
  1533.               end;
  1534.             end;
  1535.  
  1536.           EMuser0..EMuser9,    {user-defined exit commands}
  1537.           EMquit :             {exit from editor}
  1538.             begin
  1539.               SaveCurrentLine(True);
  1540.               Done := True;
  1541.             end;
  1542.  
  1543.           EMhome :             {Cursor to beginning of line}
  1544.             CurCol := 1;
  1545.  
  1546.           EMend :              {Cursor to end of line}
  1547.             CurCol := Succ(StLen);
  1548.  
  1549.           EMdelEol :           {Delete from cursor to end of line}
  1550.             if StLen > CurCol then
  1551.               StLen := Pred(CurCol);
  1552.  
  1553.           EMdelLine :          {Delete entire line}
  1554.             if CurLine = TotalLines then begin
  1555.               StLen := 0;
  1556.               CurCol := 1;
  1557.               SaveCurrentLine(True);
  1558.             end
  1559.             else begin
  1560.               DelLinePrim(CurLine);
  1561.               CurCol := 1;
  1562.               LoadLine(CurLine, True);
  1563.               ForceRedraw := True;
  1564.             end;
  1565.  
  1566.           EMrestore :          {Restore default and continue}
  1567.             begin
  1568.               St := OldSt;
  1569.               CurCol := OldCol;
  1570.             end;
  1571.  
  1572.           EMleft :             {Cursor left by one character}
  1573.             if CurCol > 1 then
  1574.               Dec(CurCol);
  1575.  
  1576.           EMright :            {Cursor right by one character}
  1577.             Inc(CurCol);
  1578.  
  1579.           EMup :               {Cursor up one line}
  1580.             if CurLine > 1 then
  1581.               GotoLine(CurLine-1, True);
  1582.  
  1583.           EMdown :             {Cursor down one line}
  1584.             if CurLine < TotalLines then
  1585.               GotoLine(CurLine+1, True);
  1586.  
  1587.           EMscrollUp :         {Scroll display up one line}
  1588.             if LineAtTop > 1 then begin
  1589.               ScrollDisplay(-1);
  1590.               I := LineAtTop+(YH-YL);
  1591.               if CurLine > I then
  1592.                 GotoLine(I, True);
  1593.             end;
  1594.  
  1595.           EMscrollDown :       {Scroll display down one line}
  1596.             if LineAtTop < TotalLines then begin
  1597.               ScrollDisplay(1);
  1598.               if CurLine < LineAtTop then
  1599.                 GotoLine(LineAtTop, True);
  1600.             end;
  1601.  
  1602.           EMpageUp :           {Scroll display up one page}
  1603.             if LineAtTop > 1 then begin
  1604.               I := (YH-YL);
  1605.               if I > CurLine then begin
  1606.                 PutLineAtTop(1);
  1607.                 GotoLine(1, True);
  1608.               end
  1609.               else begin
  1610.                 J := CurLine-LineAtTop;
  1611.                 PutLineAtTop(LineAtTop-I);
  1612.                 GotoLine(LineAtTop+J, True);
  1613.               end;
  1614.             end
  1615.             else
  1616.               GotoLine(1, True);
  1617.  
  1618.           EMpageDown :         {Scroll display down one page}
  1619.             if LineAtTop < TotalLines then begin
  1620.               I := (YH-YL);
  1621.               if TotalLines <= Succ(I) then begin
  1622.                 PutLineAtTop(TotalLines);
  1623.                 GotoLine(TotalLines, True);
  1624.               end
  1625.               else begin
  1626.                 J := CurLine-LineAtTop;
  1627.                 PutLineAtTop(LineAtTop+I);
  1628.                 GotoLine(LineAtTop+J, True);
  1629.               end;
  1630.             end;
  1631.  
  1632.           EMscreenTop :        {Cursor to top of screen}
  1633.             GotoLine(LineAtTop, True);
  1634.  
  1635.           EMscreenBot :        {Cursor to bottom of screen}
  1636.             GotoLine(LineAtTop+(YH-YL), True);
  1637.  
  1638.           EMtopOfFile :        {Cursor to top of file}
  1639.             TopOfFile;
  1640.  
  1641.           EMendOfFile :        {Cursor to bottom of file}
  1642.             begin
  1643.               I := YH-YL;
  1644.               if CurLine < TotalLines-I then
  1645.                 PutLineAtTop(TotalLines-I);
  1646.               GotoLine(TotalLines, True);
  1647.               CurCol := Succ(StLen);
  1648.               OldCol := CurCol;
  1649.             end;
  1650.  
  1651.           EMtab :              {Tab}
  1652.             begin
  1653.               I := Succ(Succ(CurCol div TabDelta) * TabDelta);
  1654.               if (not InsertMode) or (CurCol > StLen) then
  1655.                 CurCol := I
  1656.               else if (CurCol <= StLen) then begin
  1657.                 if InsertOK(I-CurCol) and (Margin-StLen > I-CurCol) then begin
  1658.                   Insert(CharStr(' ', I-CurCol), St, CurCol);
  1659.                   CurCol := I;
  1660.                 end;
  1661.               end
  1662.             end;
  1663.  
  1664.           EMwordLeft :         {Cursor left one word}
  1665.             if CurCol > 1 then begin
  1666.               Dec(CurCol);
  1667.               while (CurCol >= 1) and ((CurCol > StLen) or (St[CurCol] = ' ')) do
  1668.                 Dec(CurCol);
  1669.               while (CurCol >= 1) and (St[CurCol] <> ' ') do
  1670.                 Dec(CurCol);
  1671.               Inc(CurCol);
  1672.             end
  1673.             else if CurLine > 1 then begin
  1674.               GotoLine(CurLine-1, True);
  1675.               CurCol := Succ(StLen);
  1676.               OldCol := CurCol;
  1677.             end;
  1678.  
  1679.           EMwordRight :        {Cursor right one word}
  1680.             begin
  1681.               if CurCol < StLen then begin
  1682.                 Inc(CurCol);
  1683.                 while (CurCol <= StLen) and (St[CurCol] <> ' ') do
  1684.                   Inc(CurCol);
  1685.                 while (CurCol <= StLen) and (St[CurCol] = ' ') do
  1686.                   Inc(CurCol);
  1687.               end
  1688.               else if CurLine < TotalLines then begin
  1689.                 GotoLine(CurLine+1, True);
  1690.                 CurCol := 1;
  1691.                 OldCol := 1;
  1692.               end;
  1693.             end;
  1694.  
  1695.           EMdel :              {Delete current character}
  1696.             if CurCol <= StLen then
  1697.               Delete(St, CurCol, 1);
  1698.  
  1699.           EMback :             {Backspace one character}
  1700.             if CurCol > 1 then begin
  1701.               Dec(CurCol);
  1702.               Delete(St, CurCol, 1);
  1703.             end
  1704.             else if CurLine > 1 then begin
  1705.               GotoLine(CurLine-1, True);
  1706.               CurCol := Succ(StLen);
  1707.               JoinLinePrim(CurLine+1);
  1708.               LoadLine(CurLine, True);
  1709.               ForceRedraw := True;
  1710.               OldCol := CurCol;
  1711.             end;
  1712.  
  1713.           EMdelWord :          {Delete word to right of cursor}
  1714.             begin
  1715.               if CurCol <= StLen then
  1716.                 DeleteWordPrim
  1717.               else if CurLine < TotalLines then
  1718.                 if InsertOK(CurCol-StLen) then begin
  1719.                   FillChar(St[Succ(StLen)], CurCol-StLen, ' ');
  1720.                   StLen := Pred(CurCol);
  1721.                   I := CurCol;
  1722.                   SaveCurrentLine(False);
  1723.                   JoinLinePrim(CurLine+1);
  1724.                   LoadLine(CurLine, True);
  1725.                   CurCol := I;
  1726.                   ForceRedraw := True;
  1727.                   OldCol := CurCol;
  1728.                 end;
  1729.             end;
  1730.  
  1731.           EMins :              {Toggle insert mode}
  1732.             ToggleInsertMode;
  1733.  
  1734.           EMindent :           {Toggle auto-indent mode}
  1735.             IndentMode := not IndentMode;
  1736.  
  1737.           EMwordWrap :         {Toggle word wrap}
  1738.             WordWrap := not WordWrap;
  1739.  
  1740.           EMreformatP :        {Reformat paragraph}
  1741.             begin
  1742.               ReformatParagraph;
  1743.               CheckLineLimit;
  1744.             end;
  1745.  
  1746.           EMreformatG :        {Global reformat}
  1747.             begin
  1748.               ReformatGlobally;
  1749.               CheckLineLimit;
  1750.             end;
  1751.  
  1752.           {$IFDEF UseMouse}
  1753.  
  1754.           EMmouse :            {Mouse select}
  1755.             if MemoMouseEnabled then
  1756.               MouseSelect;
  1757.  
  1758.           {$ENDIF}
  1759.  
  1760.           EMhelp :             {Help}
  1761.             if MemoHelpPtr <> nil then
  1762.               HelpRoutine(HelpForMemo, @EMCB, HelpTopic);
  1763.         end;
  1764.  
  1765.       until Done;
  1766.  
  1767.       {redraw the screen one last time}
  1768.       RedrawScreen;
  1769.  
  1770.       {restore break checking status}
  1771.       CheckBreak := SaveBreak;
  1772.  
  1773.       {Restore cursor position and shape}
  1774.       RestoreCursorState(CursorXY, CursorSL);
  1775.  
  1776.       {$IFDEF UseMouse}
  1777.       ShowMousePrim(SaveMouse);
  1778.       {$ENDIF}
  1779.  
  1780.       {return exit code}
  1781.       EditMemo := EMC;
  1782.     end;
  1783.   end;
  1784.  
  1785.   function AddMemoCommand(Cmd : EMtype; NumKeys : Byte; Key1, Key2 : Word) : Boolean;
  1786.     {-Add a new command key assignment or change an existing one}
  1787.   begin
  1788.     AddMemoCommand :=
  1789.       AddCommandPrim(MemoKeySet, MemoKeyMax, Cmd, NumKeys, Key1, Key2);
  1790.   end;
  1791.  
  1792.   {$IFDEF UseMouse}
  1793.   procedure EnableMemoMouse;
  1794.     {-Enable mouse support in TPMEMO}
  1795.   begin
  1796.     if MouseInstalled and not MemoMouseEnabled then begin
  1797.       MemoKeyPtr := @ReadKeyOrButton;
  1798.       EnableEventHandling;
  1799.       MemoMouseEnabled := True;
  1800.     end;
  1801.   end;
  1802.  
  1803.   procedure DisableMemoMouse;
  1804.     {-Disable mouse support in TPMEMO}
  1805.   begin
  1806.     if MemoMouseEnabled then begin
  1807.       MemoKeyPtr := @ReadKeyWord;
  1808.       DisableEventHandling;
  1809.       MemoMouseEnabled := False;
  1810.     end;
  1811.   end;
  1812.   {$ENDIF}
  1813.  
  1814.   function ReadMemoFile(var Buffer; BufferSize : Word;
  1815.                         FName : string; var FSize : LongInt) : MemoStatusType;
  1816.     {-Read a file into Buffer, returning a status code}
  1817.   var
  1818.     Buf : array[1..65521] of Char absolute Buffer;
  1819.     F : file;
  1820.     I, BytesRead, BytesToRead : Word;
  1821.     MaxSize : LongInt;
  1822.   begin
  1823.     ReadMemoFile := mstNotFound;
  1824.     FSize := 0;
  1825.     Buf[1] := ^Z;
  1826.     if Length(FName) = 0 then
  1827.       Exit;
  1828.  
  1829.     {try to open file}
  1830.     Assign(F, FName);
  1831.     Reset(F, 1);
  1832.     I := IoResult;
  1833.  
  1834.     {check for invalid pathname}
  1835.     if I = 3 then
  1836.       ReadMemoFile := mstInvalidName;
  1837.  
  1838.     if I <> 0 then
  1839.       Exit;
  1840.  
  1841.     {check the file size}
  1842.     FSize := FileSize(F);
  1843.     MaxSize := LongInt(BufferSize)-Succ(SafetyMargin);
  1844.     if (FSize <= MaxSize) then
  1845.       BytesToRead := FSize
  1846.     else if AllowTruncation then
  1847.       BytesToRead := MaxSize
  1848.     else begin
  1849.       {file too big}
  1850.       ReadMemoFile := mstTooLarge;
  1851.       Close(F);
  1852.       I := IoResult;
  1853.       Exit;
  1854.     end;
  1855.  
  1856.     {read the file into the buffer}
  1857.     BlockRead(F, Buf, BytesToRead, BytesRead);
  1858.     if (BytesRead <> BytesToRead) then begin
  1859.       ReadMemoFile := mstReadError;
  1860.       Close(F);
  1861.       I := IoResult;
  1862.     end
  1863.     else begin
  1864.       Close(F);
  1865.       if IoResult = 0 then
  1866.         if FSize > MaxSize then
  1867.           ReadMemoFile := mstTruncated
  1868.         else
  1869.           ReadMemoFile := mstOK
  1870.       else
  1871.         ReadMemoFile := mstCloseError;
  1872.     end;
  1873.  
  1874.     {make sure there's a ^Z at the end of the buffer}
  1875.     Buf[FSize+1] := ^Z;
  1876.   end;
  1877.  
  1878.   function SaveMemoFile(var EMCB : EMcontrolBlock; FName : string;
  1879.                         MakeBackup : Boolean) : MemoStatusType;
  1880.     {-Save the current file in the text buffer associated with EMCB}
  1881.   var
  1882.     F : file;
  1883.     I, BytesWritten : Word;
  1884.  
  1885.     function Exist(FName : string; var F : file) : Boolean;
  1886.       {-Return true and assigned file handle if file exists}
  1887.     var
  1888.       I : Word;
  1889.     begin
  1890.       Assign(F, FName);
  1891.       Reset(F);
  1892.       Exist := (IoResult = 0);
  1893.       Close(F);
  1894.       I := IoResult;
  1895.     end;
  1896.  
  1897.     procedure MakeBakFile(NewName : string);
  1898.       {-Make a backup file}
  1899.     var
  1900.       NF, BF : file;
  1901.       BakName : string;
  1902.     begin
  1903.       if Exist(NewName, NF) then begin
  1904.         BakName := ForceExtension(NewName, 'BAK');
  1905.         if Exist(BakName, BF) then
  1906.           Erase(BF);
  1907.         Rename(NF, BakName);
  1908.       end;
  1909.     end;
  1910.  
  1911.   begin
  1912.     with EMCB do begin
  1913.       if MakeBackup then
  1914.         MakeBakFile(FName);
  1915.  
  1916.       Assign(F, FName);
  1917.       Rewrite(F, 1);
  1918.       if IoResult <> 0 then begin
  1919.         SaveMemoFile := mstCreationError;
  1920.         Close(F);
  1921.         I := IoResult;
  1922.         Exit;
  1923.       end;
  1924.  
  1925.       BlockWrite(F, BufPtr^, TotalBytes, BytesWritten);
  1926.       if (BytesWritten <> TotalBytes) or (IoResult <> 0) then begin
  1927.         SaveMemoFile := mstWriteError;
  1928.         Close(F);
  1929.         Exit;
  1930.       end;
  1931.  
  1932.       Close(F);
  1933.       if IoResult <> 0 then begin
  1934.         SaveMemoFile := mstCloseError;
  1935.         Exit;
  1936.       end;
  1937.  
  1938.       {reset modified flag}
  1939.       Modified := False;
  1940.  
  1941.       SaveMemoFile := mstOK;
  1942.     end;
  1943.   end;
  1944.  
  1945. begin
  1946.   {initialize pointer to keyboard input routine}
  1947.   MemoKeyPtr := @ReadKeyWord;
  1948. end.
  1949.